home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
BBS Toolkit
/
BBS Toolkit.iso
/
doors_1
/
e2a102.zip
/
E2A.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1991-09-07
|
13KB
|
307 lines
Program e2a;
{--------------------------------------------------------}
{ Quick And Dirty OPUS 1.7x SYSMSG.DAT --> AREAS.BBS and }
{ AREADESC.ME2 converter (for ME2 by Dugfrisk Limited) }
{ }
{ Donated to the Public Domain. }
{ Parts taken from OPUS_API (c) OPUS Development Team. }
{ }
{ Written by : G.Th. de Haan }
{ Jan Stadelaarstraat 29 }
{ 1241CA Kortenhoef }
{ The Netherlands }
{ FidoNet 2:500/226 OPUS_GTH }
{ }
{ Have fun! }
{--------------------------------------------------------}
Uses Dos,Crt;
Const
Version = '1.02';
Type
_msgsys =
Record
Area_Name : Array [0..31] of char; { This area's name }
Echo_Name : Array [0..31] of char; { The echo title for this area }
Area_Number : Word; { Area number }
Area_Menu : Word; { Which menu to user }
Total_Size : Word; { Total size of this area in SYSMSG.DAT }
Area_Priv : Byte; { Access Privilege }
Edit_Priv : Byte; { Edit privilege. Affects E)nter and R)eply }
Private_Priv : Byte; { Privilege to read PRIVATE messages }
Upload_Up : Byte; { Privilege to U)pload messages }
fill_Byte1 : Array [0..2] of Byte; { empty }
Translate : Byte; { Translation Table number for this area }
Area_Lock : Longint; { Access Lock }
Edit_Lock : Longint; { Edit lock }
Private_Lock : Longint; { Lock to read PRIVATE messages }
Upload_Lock : Longint; { Upload lock }
Attrib : Word; { Area Attribute. See Opus.H }
Status : Word; { Area Status. Used internally. }
Start_Pos : Longint; { Position in SYSMSG.DAT where area starts }
Section : Longint; { Area Section flag(s) }
Max_Lines : Byte; { Maximum number of lines in messages here }
fill_Byte2 : Array [0..2] of Byte; { empty }
Zone : Word; { Zone address for messages from this area }
Net : Word; { Net address for messages from this area }
Node : Word; { Node address for messages from this area }
Point : Word; { Point address for messages from this area }
Path_Len : Byte; { Path to messages }
Title_Len : Byte; { Title for area }
Barricade_Len : Byte; { Barricade for area }
Origin_Len : Byte; { Origin string for area }
Domain_Len : Byte; { Domain for MSGID }
Menu_Len : Byte; { ASCII menu for this area }
Vol_Len : Byte; { Volume ID for drive that holds messages }
Help_Len : Byte; { Help path for custom help }
Scan_Len : Byte; { How many boards recieve echos from you }
Scan_Pos : Byte; { Used internally }
Other_Len : Word; { Used by external programs }
Extern_Flags : Word; { Flags to tell external programs what to do }
fill_Word : Array[0..4] of Word; { empty }
End;
_ascan =
Record { Structure of one scan-to }
Net : Integer;
Node : Integer;
End;
Var
amsg : _msgsys; { The header part of SysMsg.Dat }
scans : Array [0..255] of _ascan; { Addresses of who gets echo }
fh : Integer; { MS-DOS File handle }
FileDone : Boolean; { Done with SysMsg.dat? }
i : Integer; { Just a counter }
Reg : Registers; { What would we do without them? }
DirInfo : Searchrec; { For directory search }
Path, { Path to messages }
Title, { Title string }
EchoName, { EchoName String }
ZoneStr, { Wich Zone is this area in? }
MetooPath, { Points to Me2 }
OutFileVar, { Full Path of AREAS.BBS }
InFileVar, { Full path of SSYSMSG.DAT }
AdescFileVar : String; { Full path of AREADESC.ME2 }
InFile, { File variable for SYSMSG.DAT }
AreasFile, { File variable for AREAS.BBS }
AdescFile : Text; { File variable for AREADESC.ME2 }
Procedure ProgEnd(ErrLvl:Integer);
Begin
If (ErrLvl > 0) AND
(ErrLvl < 4) Then
Write(#7,'*** ERROR #',ErrLvl,' *** ');
Case ErrLvl Of
0 : WriteLn('DONE!');
1 : WriteLn('SYSMSG.DAT not found!');
2 : WriteLn('Unable to open AREAS.BBS!');
3 : WriteLn('Unable to open AREADESC.ME2!');
4 : WriteLn(#13#10,'Usage : E2A Path\for\InFile Path\for\OutFiles',
#13#10, ' Use . for current directory.');
End;
Halt(ErrLvl);
End;
Procedure ProgInit;
Begin
WriteLn(#13#10,'E2A Version ',Version,
#13#10,'creates AREAS.BBS and AREADESC.ME2',
#13#10,'Written by : Gerard de Haan',
#13#10,' 2:500/226@Fidonet.Org');
If ParamCount = 2 Then
Begin
If Copy(ParamStr(1),Length(ParamStr(1)),1) = '\' Then
InFileVar := ParamStr(1) + 'SYSMSG.DAT'
Else
InFileVar := ParamStr(1) + '\SYSMSG.DAT';
FindFirst(InFileVar,Archive,DirInfo);
If DosError <> 0 Then { Is SYSMSG.DAT really there? }
ProgEnd(1);
InFileVar := InFileVar + #00; { Now null terminated string also }
If Copy(ParamStr(2),Length(ParamStr(2)),1) = '\' Then
MetooPath := ParamStr(2)
Else
MetooPath := ParamStr(2) + '\';
OutFileVar := MeTooPath + 'AREAS.BBS';
ADescFileVar := MeTooPath + 'AREADESC.ME2';
Assign(AreasFile,OutFileVar); { Open the OutFiles }
{$I-} Rewrite(AreasFile); {$I+}
If IOResult <> 0 Then
ProgEnd(2); { Disk full? }
Assign(AdescFile,AdescFileVar);
{$I-} Rewrite(AdescFile); {$I+}
If IOResult <> 0 Then
Begin
Close(AreasFile);
ProgEnd(3); { Disk full? }
End;
WriteLn(AreasFile,';'); { The first line of AREAS.BBS }
End
Else
ProgEnd(4); { Tell 'em WhatToDo }
End;
Function FillOut(Strn : String; TotLen : Integer) : String;
Begin { Left-justify a string }
TotLen := TotLen - Length(Strn);
While TotLen <> 0 DO
Begin
Strn := Strn + ' ';
Dec(TotLen);
End;
FillOut := Strn;
End;
Procedure Process_SysMsgDat(DoEchoArea : Boolean);
Begin
Reg.AH := $3D; { Open File Handle }
Reg.AL := $0;
Reg.DS := Seg(InFileVar);
Reg.DX := Ofs(InFileVar)+1;
MsDos(Reg);
fh := Reg.AX;
Reg.Flags := 0;
FileDone := False;
Repeat
Reg.AX := $3F00; { Read in the Structure }
Reg.BX := fh;
Reg.CX := sizeof(_msgsys);
Reg.DS := Seg(amsg);
Reg.DX := Ofs(amsg);
MsDos(Reg);
If Reg.AX <> sizeof(_msgsys) Then
FileDone := True
Else
Begin
Reg.AX := $3F00; { Read in the Msg_Path }
Reg.BX := fh;
Reg.CX := amsg.Path_Len;
Reg.DS := Seg(Path);
Reg.DX := Ofs(Path)+1;
MsDos(Reg);
Path[0] := Char(Amsg.Path_Len);
Reg.AX := $3F00; { Read in the Title }
Reg.BX := fh;
Reg.CX := amsg.Title_Len;
Reg.DS := Seg(Title);
Reg.DX := Ofs(Title)+1;
MsDos(Reg);
Title[0] := Char(Amsg.Title_Len);
Reg.AX := $4201; { Skip this lot }
Reg.BX := fh;
Reg.CX := 0; { Since this is a Word, high-order is 0 }
Reg.DX := amsg.Barricade_Len +
amsg.Origin_Len +
amsg.Domain_Len +
amsg.Menu_Len +
amsg.Help_Len +
amsg.Vol_Len;
MsDos(Reg);
FillChar(scans,1024,0); { Just to be sure ... }
Reg.AX := $3F00; { Read in the Echo Scan structures }
Reg.BX := fh;
Reg.CX := (amsg.Scan_Len * sizeof(_ascan));
Reg.DS := Seg(scans);
Reg.DX := Ofs(scans);
MsDos(Reg);
Reg.AX := $4201; { Skip the rest }
Reg.BX := fh;
Reg.CX := 0; { Since this is a Word, high-order is 0 }
Reg.DX := amsg.Other_Len;
MsDos(Reg);
{ Write to Areadesc.me2 }
If ((amsg.Attrib AND 32) = 0) AND { LOCAL }
(DoEchoArea = False) Then { only when we want to }
Begin
If (amsg.Attrib AND 1) = 0 Then { NO MATRIX }
WriteLn(AdescFile,FillOut('LOCAL',9) +
FillOut('''' + Copy(Title,1,38) + '''',40) +
'''' + Path + '''');
End;
If ((amsg.Attrib AND 32) = 32) AND { ECHO! Echo, echo ... }
(DoEchoArea = True) Then { only when we want to }
Begin
i := 0; { Convert to Pascal String }
While amsg.Echo_Name[i] <> #0 DO
Begin
EchoName[i+1] := amsg.Echo_Name[i];
inc(i);
End;
EchoName[0] := Char(i); { Fill in length Byte }
If (amsg.Zone <> 2) AND { What zone are we in? }
(amsg.Zone <> 0) Then
Begin
Str(amsg.Zone,ZoneStr);
ZoneStr := ZoneStr + ':';
End
Else
ZoneStr := '';
Write(AreasFile,FillOut(Path,40) + { Write to Areas.Bbs }
FillOut(EchoName,25));
For i := 0 TO amsg.Scan_Len-1 DO
Write(AreasFile,ZoneStr,
Scans[i].Net,'/',Scans[i].Node,' ');
WriteLn(AreasFile);
{ Write to Areadesc.me2 }
WriteLn(AdescFile,FillOut(EchoName,32) +
FillOut('''' + Copy(Title,1,38) + '''',40) +
'''Echo''');
End;
End;
Until FileDone = True;
Reg.AX := $3E00; { Close SYSMSG.DAT }
Reg.BX := fh;
MsDos(Reg);
End;
Begin
ProgInit;
Process_SysMsgDat(False); { Do LOCAL areas FIRST! }
Process_SysMsgDat(True);
Close(AreasFile);
Close(AdescFile);
ProgEnd(0);
End.